COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C  SUBRS.  SLUR, (JUGGLE), (LOOP), PLTSRT, (LINES), (HOMER),
C00026 ENDMK
C⊗;
C  SUBRS.  SLUR, (JUGGLE), (LOOP), PLTSRT, (LINES), (HOMER),
C  (PLACE), (FINDIT), SCL, FORMAT

	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	COMMON/SLR/ SLURX(32)
	REAL CENTR
	COMMON /XRN/RN(2000) /PLTR/PLT,RHT,RDIS
	COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
	1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
	1 J5,J6,J7,J8,J9,J10,J11,JQ(8),RJ
	COMMON/PTR/PWDS(250),ITEM,L,I,IX /STF/RSTFAC(-3/4),RSTJ2
	COMMON/ALF/INP,SLURY(72) 
CF	DATA RZZ/2.8/
C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8	

CCC	IF(JA.NE.12)GO TO 2
CF	RA=5.96*RSTJ2*R5
CF	L=3
CF	J8=J8*RDIS
CF	IF(J7.LE.J6)J7=J7+360
CF	KQ=6
CF	IF(PLT)KQ=1
CF10	DO 3 K=J6,J7,KQ
CF	R=K
CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
CF3	L=2
CF	J8=J8-1
CF	IF(J8)RETURN
CF	RA=RA+1/RDIS
CF	L=3
CF	GO TO 10
CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
CCC	CALL CIRCLE
CCC	RETURN

C*** SLURS *** 5, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
C  P9=NUM IN BRACKET(IF NON-ZERO)
2	J10=1
	J4=-1
	J5=1
C  ↑↑↑↑ FOR DPY ONLY (32 SEGS ARE USED)
	TWICE=-1
	IF(R6)R6=202
C  R6=NEG. IS FOR PAGE-LAYOUT PROG. TELLS WHICH NOTE TO SLUR TO.
21	RST7=RSTJ2*7.
	RJ=ABS(R7)
C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
	IF(RJ.LT.100)RJ=-1
	R7=AMOD(R7,100.0)
	IF(RJ.LT.300)GO TO 20
	RJ=0
CC*** NOT YET!	R5=R5-(2*R7)
C R5 THINKS THE SLUR ISN'T REVERSED.
C TO USE THIS ADD R6=SQRT((R5-R4)**2+(R6-R3)**2)+R3(WITH FACTORS)
20	RQQ=R5-R4
	IF(R6.GT.1000)CALL RNOTE(R6)
	GO TO (5,6,7),J8+4
	GO TO 4
CC5	R=32
5	R=30
C AFTER DOTTED NOTE
	GO TO 8
CC6	R=22
6	R=18
C BETWEEN NOTES
CC8	RX=-1.3
8	RX=-0.75
	GO TO 9
7	R=7
	RX=RSTJ2
9	CALL RJBX(R)
	R6=R6+RX
4	RXX=RHORZ(R6)-R3
	RTILT=RQQ*RST7
80	RX=SQRT(RXX**2+RTILT**2)
	IF(J8.NE.-1)GO TO 1
	IF(RQQ.GT.8)RQQ=8
	IF(RQQ.LT.-8)RQQ=-8
	RQQ=RQQ*RSTFAC(J2)*1.0
	IF(R7)RQQ=-RQQ
	R3=R3-RQQ
C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
1	R=CENTR
	IF(J8.GT.0)GO TO 180
C  JUMP FOR BRACKETS
	L=32
	CALL SLOOP

CF	RB=RX/71.
CF	DO 81 K=0,71
CF81	SLURX(K+1)=RB*(K)+R3
CF	RA=R7*RST7
CF41	IF(R9.EQ.0)R9=RZZ
CF	R=R+RA
CF	L=0
CF	DO 40 K=36,1,-1
CF	L=L+1
CF	RW=R-RA*(K/36.)**R9
CF	SLURY(L)=RW
CF40	SLURY(73-L)=RW
CF	L=72

CF89	IF(RTILT.EQ.0)GO TO 87
CF	RW=ATAN2(RTILT,RXX)
CF	RA=SIN(RW)
CF	RB=COS(RW)
CF	RZ=SLURX(1)
CF	RW=SLURY(1)
CF	DO 83 K=1,L
CF	R=SLURX(K)-RZ
CF	RXX=SLURY(K)-RW
CF	SLURX(K)=RB*R-RA*RXX+RZ
CF83	SLURY(K)=RB*RXX+RA*R+RW

87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
	J6=J10
	J7=L
	IF(J4.NE.0)GO TO 22
	CALL EXCH(J6,J7)
	J5=-1
22	DO 88 K=J6,J7,J5
88	CALL LINES(SLURX(K),SLURY(K),2)
	IF(J5.GT.1)CALL LINES(SLURX(L),SLURY(L),2)
C  DISPLAY END POINT OF SLUR
	IF(TWICE)RETURN
	TWICE=TWICE-1
	GO TO 182
180	RW=R+R7*RST7
	TWICE=-1
CC	KQ=1
	J5=1
	RX=RX+R3
CC	RA=(R5-R4)*RST7
	IF(J9.EQ.0)GO TO 181
	RZ=RTILT/(RX-R3)
	TWICE=2
CC	RZ=RX-R3
	RXX=RX
	RWID=(R3+RXX)/2.
182	IF(TWICE.EQ.1)GO TO 183
C  DOES LEFT SIDE FIRST.
	IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
	J8=2
	RC=RSTJ2*13.
	RX=RWID-RC
	RWW=RTILT
185	RTILT=RZ*(RX-R3)

C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.

	GO TO 181
183	J8=3
	RX=RXX
	RTILT=RWW
	RXX=R3
	R3=RWID+RC
	RXX=RZ*(R3-RXX)
	R=R+RXX
	RW=RW+RXX
	GO TO 185

181	SLURX(1)=R3
	SLURY(1)=R
	SLURX(2)=R3
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RTILT
	SLURX(4)=RX
	SLURY(4)=R+RTILT
	L=4
	IF(J8.EQ.2)L=3
	IF(J8.EQ.3)J10=2
CC	TWICE=-1
	GO TO 87
184	J3=RWID
C  PUT IN VERT. POS. WHEN SLOPE!
	R4=RQQ/2.+R4+R7-1.
	R6=1.
C  R7=1 IS FOR ITALICS
	R7=1
C  OR USE 1 FOR ITALIC NUMBERS.
	R8=0
	CALL MAKNUM(R9)
	END

C********  JUGGLER  ********
CF	SUBROUTINE JUGGLE
CF	IMPLICIT INTEGER(A-Z)
CF	REAL PWDS,RN
CF	COMMON /DL/X22,SAVER,NAME /XRN/RN(2000)
CF    COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO

CF	ITEM=ITEM-1
CF	JX=RN(MEDIT)+3
C  WD CNT OF OLD ITEM
C  I-IX IS WD CNT OF NEW ITEM
CF	JY=IX
CF	Z=I-IX-JX
C  SPACE CHANGE
CF	IF(Z)2751,172,751
CF751	CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
CF	JY=IX+Z
CF	GO TO 172

CF2751	CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)

CF172	J=RN(JY)+2
CF	CALL LOOP(0,J,1,MEDIT,JY,RN)
CF	I=IX+Z

CF1751	X=ITEM+1
CF	JX=WDS(X22+1)-WDS(X22)
CF	J=WDS(X+1)-WDS(X)
CF	Y=J-JX
CF	JX=WDS(X)+Y+1
CF	IF(Y)2851,182,282
CF282	CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
CF	GO TO 182

CF2851	CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
CF	JX=WDS(X)+1

CF182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
CF	DO 183 K=X22+1,X
CF	PWDS(K)=PWDS(K)+Z
CF183	WDS(K)=WDS(K)+Y
CF	ST(2)=WDS(X)
CF	X22=0
CF	END


CF	SUBROUTINE LOOP(I,J,K,L,M,N)
CF	DIMENSION N(1)
CF	MM=M-L
CF	DO 1 NN=I+L,J+L,K
CF1	N(NN)=N(NN+MM)
CF	END


CXX	SUBROUTINE PLTSRT
C  SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
CF	IMPLICIT INTEGER(S-Z)
CXX	COMMON /XRN/RN(2000) /PTR/PWDS(250),ITEM,L,I,IX
CXX	COMMON/DPY/Q(3000),P(1000),WDS(250),MEDIT,IGO
C  Q AND P OCCUPY DPY BUFFER.  Q IS FOR OVERFLOW OF RN.
CXX	CALL PSRT(P)
CF	DO 4 K=1,ITEM
CF	L=PWDS(K)
CF	A=RN(L+3)
CF	P(K)=A+1000*RN(L+2)
CF4	IF(A.LT.0)GO TO 77
CF	IF(RN(L+1).NE.16.)GO TO 177
CF77CF	P(K)=-10000
C  PLOTS ALL NEG. HORIZ. POSITIONS AND WORDS(CODE 16) FIRST.
CF177CF	M=I
CF	IF(I.LT.1500)I=1500
CF	Y=I
CF	I=I+M-1
CF	M=Y
C  M IS IN MAIN PROG., LEAVES 1500 WDS IN RN FOR "NOIR" DATA.
CF2CF	A=P(1)
CF	L=1
CF	DO 1 K=1,ITEM
CF	IF(A.LE.P(K))GO TO 1
CF	A=P(K)
CF	L=K
CF1CF	CONTINUE
CF	IF(A.EQ.10000.)RETURN
C  ALL ITEMS HAVE NOW BEEN SHUFFLED
CF	V=PWDS(L)
CF	P(L)=10000
CF	L=RN(V)+2
CF	CALL LOOP(0,L,1,Y,V,RN)
CF	Y=Y+L+1
CF	GO TO 2
CXX	END



CX	SUBROUTINE BOX(I,R)
CX    COMMON/SIZ/RSZ,JCEN,KCEN /XRN/RN(2000) /STF/RSTFAC(-3/4),RSJ/C/L,K
CX	COMMON/POSI/STFF(-3/4),JJ2,POS /RINP/RX(800),N(100)
CX	IF(I)GO TO 4
CX	K=R
CX	K=(STFF(K)+AMOD(RN(I+4),100.0)*7.*RSTFAC(K)
CX	1 -40.0)*RSZ-KCEN
C  ↑↑↑↑ WAS -60.0 10/74
C  AMOD IS FOR MINI NOTES AND CLEFS
CX	L=RHORZ(RN(I+3))*RSZ-JCEN
CX	IF(IABS(L).GT.550)L=511
CX	IF(IABS(K).GT.550)K=511
CC1	CALL ALINE(L,K,L+50,K)
CC	CALL RVECT(0,100)
CC	CALL RVECT(-50,0)
CC	CALL RVECT(0,-100)
CC	L=L+25
CC2	CALL ALINE(L,K-25,L,K+125)
CC3	CALL DPYOUT(1)
CX	CALL SETCUR(L,K,0)
CX	RETURN
CX4	IF(I.LT.-1)GO TO 5
CX	CALL DPYSET(3,N,100)
CX	CALL DPYBRT(3)
CX5	L=RHORZ(R)*RSZ-JCEN
CX	IF(IABS(L).GT.550)GO TO 6
C DOESN'T TRY TO DRAW LINE OFF SCREEN
CX	CALL SETPOG(3)
CX	CALL ALINE(L,-511,L,511)
CX	CALL DPYOUT(3)
CX6	CALL SETPOG(1)
CX	END

CC	SUBROUTINE LINES(A,B,L)
CC	COMMON/DST/BB,CC
CC	COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
CC	COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
CC	COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
CC	COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
CC	EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
CC	1,(JJ2,JJ(2))
CC	DATA BB/.008/,CC/3.5/
C  SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
CC	GO TO 23
CC
CC22	IF(JQ(1).NE.0)GO TO 23
CC	IF(CC.EQ.1000)GO TO 23
C  ABOVE TO SKIP DISTORTION ON COMMAND
C  CHANGE ABOVE TO 'JFCL' IN DDT TO USE NEXT ITEMS.
C  USE THIS IN DDT TO DISTORT ITEMS.  CC MUST BE > DD
CC	B=B*(CC-BB*ABS(A))
C  CC IS HGT FACTOR.
CC23	IF(IPLT)GO TO 2
CC	M=A*RSZ
CC	N=B*RSZ
CC	IF(RSZ.LE.0.8571)GO TO 3
C NEXT FOR DISPLAY MAGNIFICATION
CC	M=M-JCEN
CC	N=N-KCEN
CC	IF(JA.NE.8)GO TO 5
C NEXT INSURES DISPLAY OF STAFF LINES
CC	IF(M.GT.511)M=511
CC	IF(M.LT.-511)M=-511
CC5	IF(IABS(M).GT.512)GO TO 77
CC	IF(IABS(N).LT.512)GO TO 4
C  NOW DRAWS INVISIBLE VECT. IF IT GOES OFF THE SCREEN.
CC77	KZ=-1
CC	RETURN
CC4	IF(KZ.EQ.0)GO TO 6
CC	KZ=0
CC	GO TO 1
CC3	IF(JA.EQ.44)GO TO 6
C JA=44=BAR LINES - THEY DON'T FIGURE IN MAX. HGT.
CC	K=B
CC	IF(K.GT.ITOP)ITOP=B
CC	IF(K.LT.IBOT)IBOT=B
CC6	IF(JJ2.GT.3990)RETURN
CC	IF(L.EQ.3)GO TO 1
CC	CALL AVECT(M,N)
CC	RETURN
CC1	CALL AIVECT(M,N)
CC	RETURN
CC2	IF(IPLT.EQ.-2)RETURN
C RXGP SETS UP-DOWN POS. ON XEROX PAPER (FRACTIONAL POSITIONS POSSIBLE.)
CC9	M=ROFF(A*DIS)
CC	N=ROFF(B*RHT)
CC8	CALL PLOT(M,N,L)
CC	END

C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
CF	SUBROUTINE HOMER
CF	IMPLICIT INTEGER(A-Q,S-Z)
CF	REAL PWDS,DISX,A,B,PLACE,STFF
CF	COMMON /STF/RSTFAC(-3/4),RSTJ2
CF    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
CF	COMMON /XRN/RN(2000) /PTR/PWDS(250),ITEM,L,I,IX
CF	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
CF	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(2000))
CF	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
CF	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
CF	IF(JA.EQ.6)GO TO 9
CF	IF(R13.NE.0)GO TO 10
C  FOR GENL HOMING; WORDS;  BEAMS;  STEMS;

CF	IF(JQ(1).EQ.0)GO TO 197
C  TO HOME IN ON NOTE ON DIFFERENT STAFF.
CF	JJ2=R2
CF	K=PWDS(JJ2)
CF	L=PWDS(JQ(1))
CF	RA=RN(K+3)
CF	RB=RN(L+3)
C  RB=POS OF NOTE,  RA=POS(P3) OF BEAM
CF	N=0
CF	IF(RN(L+5).LT.20)N=-1
C  -1 MEANS STEM IS UP
CF	RG=-(AMOD(RN(K+7),10.)-1.)*11./7.
C   SPACE FOR THE NUMB. OF BEAMS
CF	J11=RN(L+2)
CF	M=0
CF	IF(RN(K+7).LT.20.)M=-1
CF	X=RN(K+2)
C  THE STAFF NUMS.  X=BEAM   J11=NOTE
CF	R3=RSTFAC(X)
CF	R9=RSTFAC(J11)/R3
CF	R8=R3*14.54/5.96
C  R8=WIDTH OF NOTE
C******* 5/74  BOTH STAVES MUST BE SAME SIZE - MOST LIKELY ********
CF	R7=96./7.
C  MUST BE DOUBLE STEM LENGTH
CF	RD=RN(L+8)
CCCF	IF(RD.EQ.999)RD=0
C  THE STEM LENGTH
CF3	IF(M.NE.N)GO TO 5
CF	R8=0
CF	R7=0
CF	RG=0
CF	GO TO 4
CF5	IF(M.EQ.0)GO TO 4
CF	R7=-R7
CF	R8=-R8
CF	RD=-RD
CF	RG=-RG

C  NOT OK IF DIFF SIZES AND RA.GT.RB ****** 5/74
CF4	RN(K+6)=RB+R8
C  SETS CORRECT HORIZANTAL PARAM OF BEAM.
CF	RF=7.*R9
CF	RE=(STFF(J11)-STFF(X))/RF
C  DIST BETWEEN STAVES.
CF	RN(K+5)=RN(L+4)+RE+(R7+RD+RG)*R9
CF	RETURN

C*********************************************************
C  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
CF197	JJ2=-1

CF	R3=R2
CF	DO 191 K=1,ITEM
CF	L=PWDS(K)
CF	IF(RN(L+1).NE.6)GO TO 191
CF	IF(RN(L+2).EQ.R3)GO TO 77
CF	IF(R3.LT.5.)GO TO 191
C   TYPE 19 99 FOR ALL STAVES
CF77	RG=RN(L+7)
CF	IF(RN(L).EQ.8)GO TO 191
CF	IF(RG.LT.10.)GO TO 191
C  FINDS BEAMS.
CF	A=RN(L+3)-.01
CF	B=RN(L+6)+.01
C  POS 1 AND 2
CF	DISX=B-A
C  DISTANCE IN REAL STEPS
CF	RB=AMOD(RN(L+5),100.0)
C  NOTE 2
CF	RF=AMOD(RN(L+4),100.0)
CF	RD=RB-RF
C  HEIGHT
CF	R2=RN(L+2)
C  ↑↑↑ USED IN 'FINDIT'
CF	X=RG/10.
C  STEM DIRECT.

CF	DO 192CF	N=1,ITEM
CF	IF(FINDIT(N))GO TO 192
CF	IF(RN(L).EQ.8)GO TO 192
CF	IF(RN(L+8).EQ.1000.)GO TO 192
C SKIPS SLASHED GRACE NOTES (P8=1000 OR P10=1)
C  FINDIT IS NEG. IF(RN(L+1).NE.1.OR.RN(L+3))
CF	RC=RN(L+3)
CF	IF(RC.LT.A)GO TO 192
CF	IF(RC.GT.B)GO TO 192
C  WHAT'S LEFT IS IN BEAM AREA IF STEM DIR. IS OK.
CF	IF(X.NE.IFIX(RN(L+5)/10.))GO TO 192
CF	RC=RC-A
CF193	RE=AMOD(RN(L+4),100.0)
CF	RC=RD*RC/DISX+RF
CF	RG=RN(L+7)
CF	RN(L+7)=RG-AMOD(RG,10.0)+AMOD(RG,1.0)
C   DELETES TAILS WITHOUT REMOVING DOTS OR SPACING OF DOTS.
C  FRACTIONAL NOTE #
CF195	RA=RC-RE
CF	IF(X.EQ.2)RA=-RA
CF	IF(RA.EQ.0)RA=999.
CF196	RN(L+8)=RA
C  FRACTIONAL NOTE # - FIRST NOTE OF GROUP + THIS NOTE # ALL *7.
CF	IF(JJ2)JJ2=N
C  SAVES # OF FIRST ITEM FOUND
CF192	CONTINUE
CF191	CONTINUE
CF	RETURN

C*********************************************************
CF9	IF(J11.LT.0)RETURN
C   IF P11=-1 NO HOMING
CF	X=R7/10.
CF	IF(X)X=-X
C  X IS STEM DIRECTION
CF	RA=R9
C  R9= POS3
CF	RC=-1.
CF	IF(R9.NE.0)RC=-2.
CF	IF(J10/10.EQ.3)RC=-3
C  RC=1 ESCAPES FROM LOOP.
C   HOMING RANGE FOR BEAMS
CF10	IF(R11.EQ.0)R11=2.9
C   IF P11.NE.0 RANGE IS CHANGED FROM 2
CF	IF(JA.EQ.5)RC=-1
C******↑↑↑↑↑↑↑ WAS 8????
CF	DO 361 K=1,ITEM
CF	IF(FINDIT(K))GO TO 361
C  SKIPS NOTES ON WRONG LINE 
CF	RD=RN(L+3)
CF1	IF(JA.NE.6)GO TO 177
CF	IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
CF177	IF(PLACE(R3))GO TO 461
CF	R3=RD
C  LOOKS FOR NOTE, STAFF #, STEM DIR.
CF	IF(JA.EQ.6)GO TO 861
CF	IF(JA.EQ.5)GO TO 261
CF	RETURN

CF461	IF(JA.EQ.6)GO TO 277
CF	IF(JA.NE.5)GO TO 361
CF277	IF(PLACE(R6))GO TO 561
CF	R6=RD
CF861	IF(J7.GE.0)GO TO 261
CF561	IF(PLACE(RA))GO TO 661
CF	IF(J7)GO TO 761
C  J7=NEG MEANS TREMOLO
CF	IF(R8.EQ.0)GO TO 361
CF761	R9=RD
C  R8=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.
CF	GO TO 261
CF661	IF(JA.EQ.5)GO TO 361
CF	IF(J10.LT.30)GO TO 361
CF	IF(PLACE(R8))GO TO 361
C  HOMES INNER PARTIAL BEAMS
CF	R8=RD
CF261	RC=RC+1
CF	IF(RC.EQ.1.)RETURN
CF361	CONTINUE
CF	END

CF	FUNCTION PLACE(X)
CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(2000)
CF	EQUIVALENCE (R11,RJQ(9)),(RD,RN(2000))
CF	PLACE=R11-ABS(RD-X)
CF	END

CF	FUNCTION FINDIT(N)
CF	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
CF	COMMON /XRN/RN(2000) /PTR/PWDS(250),ITEM,L,I,IX
CF	FINDIT=0
CF	L=PWDS(N)
CF	IF(RN(L+1).NE.1)GO TO 377
CF	IF(RN(L+2).EQ.R2)RETURN
CF377	FINDIT=-1
CF	END

	SUBROUTINE SCL
C  SETS UP SCALING MARKERS.
	COMMON /STF/RSTFAC(-3/4),RSTJ2 /XRN/RN(2000)/RINP/SU(900)
	COMMON R2,JA,CT,J2,R3,R4,R5,RJQ(17),J3,J4,J5,J6,J(16)
	1 /POSI/STFF(-3/4),J102,POS
	J2=R2
	IF(J2.NE.99)GO TO 1008
	CALL HYDPOG(2)
	RETURN
1008	J5=0
	J6=0
	RSTJ2=RSTFAC(J2)
C  SETS UP SCALE LINES.
	J4=200
	IF(R3.NE.0)J4=400
C  PUTS SCALE TO 400
	R2=STFF(J2)+60.*RSTJ2
	RJ=R2+60.
	CALL DPYSET(2,SU,700)
	CALL DPYBRT(1)
	POS=RJ+40.
	RSTJ2=1.
	DO 1002 MX=10,J4,10
	RA=RHORZ(FLOAT(MX))
	R3=RA-58
	IF(MX.GT.10)CALL PNUM
CC1005	IF(R5.NE.0)GO TO 1007
C  JUMP FOR STAFF NUMBERS
	CALL LINX(RA,R2,RA,RJ)
	J5=J5+1
1002	IF(J5.EQ.10)J5=0
	CALL LINES(-596.0,RJ,2)
	CALL LINES(-596.0,R2,2)
	R6=1.5
C  NEXT SETS UP STAFF NUMBERS
	R3=-620.
	DO 1007 K=-3,4
	POS=STFF(K)+40.
	J5=IABS(K)
	CALL PNUM
1007	CONTINUE
	CALL DPYOUT(2)
	CALL SETPOG(1)
	END

C  NEXT ALLOWS YOU TO TYPE 'SA NAME' OR 'SAVE NAME' ETC.
C  (NO MORE THAN 9 CHARS. MAY COME BEFORE NAME)
	SUBROUTINE FORMAT(NAME)
C  SO WE CAN TYPE 'SA NAME' OR 'SAVE    NAME', ETC.
	COMMON /ALF/INP(72),ML 
	DIMENSION DMY(50),IFMT(2)
	EQUIVALENCE (INP(20),DMY)
	DATA IFMT(2)/' ,A5)'/

	DO 1 K=2,72
	IF(INP(K).NE.' ')GO TO 1
	DO 2 L=K+1,72
	IF(INP(L).EQ.' ')GO TO 2
C NOW WE START NAME
	L=L-1
5	IFMT(1)='( 0A1'+L*32768
C  32768 IS MAGIC NUM TO CHANGE '0' TO RIGHT NUM.
	REREAD IFMT,(DMY(K),K=1,L),NAME
	RETURN
2	CONTINUE
	NAME=' '
	RETURN
1	CONTINUE
	END
	
	SUBROUTINE NMPREP(JA,NAME,IEXT)
C FINDS SA, SAV, RS, ETC.
	DIMENSION JA(1)
	DO 1 K=1,10
	IF(JA(K).NE.' ')GO TO 1
	DO 1 J=K+1,10
	IF(JA(J).EQ.' ')GO TO 1
	CALL NAMEXT(JA(J),NAME,IEXT)
	RETURN
1 	CONTINUE
	END

	SUBROUTINE NAMEXT(JA,NAME,IEXT)
C PUSHES 1 TO 5 A1 CHARS IN A SINGLE A5 WORD.
	DIMENSION JA(10),JB(5)
	DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
	DATA MM/"774000000000/, JB(4)/' '/,JB(5)/' '/
	JXX=0
	NAME=' '
	DO 1 K=1,4
1	IF(JA(K).EQ.' '.AND.JA(K+1).NE.' ')GO TO 2
	GO TO 12
2	PAUSE 'NO BLANKS ALLOWED!!!'
	RETURN
12	DO 20 K=1,6 
	IF(JA(K).NE.'.')GO TO 20
	JXX=-1
	J2=K+1
	JA(K)=' '
	DO 21 JX=1,4 
	JB(JX)=JA(J2)
	JA(J2)=' '
21	J2=J2+1
	GO TO 50
20	CONTINUE
50	JX=6
	DO 10 K=5,1,-1
10	IF(JA(K).EQ.' ')JX=K
	IF(JX.GT.2)GO TO 51
	N=JA(1)
	GO TO 52
51	IA=JA(1)
	IF(IA)IA=MM.AND.JA(1)
	J2=2
7	IB=JA(J2)
	IBX=IB
	IF(IBX)IB=MM.AND.JA(J2)
11	K=IB.AND.LL
4 	K=K/KK
5	IF(IBX)K=K.OR.JJ
C  RESTORES LEFT HAND BIT (101 ETC.)
	IF(J2.EQ.2)GO TO 3
	DO 8 JL=1,J2-2
8	K=K/KK
3	N=IA.OR.K
	IA=N
	J2=J2+1
	IF(J2.NE.JX)GO TO 7
52	IF(NAME.NE.' ')GO TO 23
	NAME=N
	IF(JXX.EQ.0)RETURN
	DO 24 K=1,5
24	JA(K)=JB(K)
	GO TO 50
23	IEXT=N
	END